home *** CD-ROM | disk | FTP | other *** search
/ Generous Efforts of Many / gemcd.zip / GEM.CD.A.po / FEATURES:BEAGLE / BEAGLE.BAG.SHK / BEAGLE.BAG / DATE SEARCH.bas < prev    next >
BASIC Source File  |  2000-01-01  |  4KB  |  36 lines
  1. 10  TEXT : HOME :G$ =  CHR$(7): PRINT "THIS PROGRAM WILL CALCULATE THE NUMBER  OF DAYS BETWEEN TWO DATES (1801-2099).": PRINT : ONERR  GOTO 63900
  2. 20  FOR T = 1 TO 2:V = 3 +8 *(T = 2): VTAB V: GOSUB 140: INVERSE : PRINT " ENTER DATE #";T;" ": NORMAL : GOSUB 100: NEXT : VTAB V +8: GOSUB 140
  3. 90 DD =  ABS(DD(2) -DD(1)): VTAB 20: HTAB 1: NORMAL : PRINT "TIME SPAN: " INT((100 *(DD +.5))/365.244966)/100" YEARS, OR "DD" DAYS.": VTAB 21: GOSUB 140
  4. 95  NORMAL : VTAB 23: HTAB 1: CALL  -958: PRINT "HIT <RETURN> TO TRY AGAIN:": PRINT " OR <Q> TO QUIT.";: VTAB 23: HTAB 27: GET A$: PRINT A$: IF A$ =  CHR$(13)  THEN  RUN 
  5. 96  IF A$ = "Q"  THEN 63900
  6. 99  GOTO 95:<CTRL-M><CTRL-M><CTRL-M><CTRL-M>
  7. 100  RESTORE : FOR I = 1 TO 12: READ MO$,LE$: VTAB I +18 -6 *(I >6): HTAB 1 +12 *(I >6) -(I >9): PRINT I;" ";MO$;: NEXT 
  8. 102  VTAB 3 +V: HTAB 1: CALL  -868: PRINT "__<-MONTH (1-12)";: HTAB 1: INPUT "";MO$:MO(T) =  VAL(MO$): IF MO(T) <1  OR MO(T) >12  THEN  PRINT G$;: GOTO 100
  9. 105  RESTORE : FOR I = 1 TO MO(T): READ MO$,LE$: NEXT : VTAB 3 +V: HTAB 1: CALL  -958: PRINT MO$;:HT =  POS(0) +2: IF MO(T) = 2  THEN LE$ = "29": DATA JANUARY,31,FEBRUARY,28,MARCH,31,APRIL,30,MAY,31,JUNE,30,JULY,31,AUGUST,31,SEPTEMBER,30,OCTOBER,31,NOVEMBER,30,DECEMBER,31
  10. 110  VTAB 3 +V: HTAB HT: CALL  -868: PRINT "__<-DAY (1-";LE$;")";: HTAB HT: INPUT "";DA$:DA(T) =  VAL(DA$): IF DA(T) <1  OR DA(T) > VAL(LE$)  THEN  PRINT G$;: GOTO 100
  11. 115  VTAB 3 +V: HTAB HT: PRINT DA(T);",";:HT =  POS(0) +2
  12. 120  VTAB 3 +V: HTAB HT: CALL  -868: PRINT "____<-YEAR (1801-2099)";: HTAB HT: INPUT "";YR$: IF  LEN(YR$) = 2  THEN YR$ = "19" +YR$
  13. 121  VTAB 3 +V: HTAB HT: PRINT YR$;: CALL  -958: PRINT :YR(T) =  VAL(YR$): IF YR(T) <1801  OR YR(T) >2099  THEN  PRINT G$;: GOTO 100
  14. 122 LP(T) = 0: IF (YR(T) - INT(YR(T)/4) *4 = 0)  AND (YR(T) < >1800  AND YR(T) < >1900)  THEN LP(T) = 1
  15. 123  IF MO(T) = 2  AND   NOT LP(T)  THEN LE$ = "28"
  16. 125  IF MO(T) = 2  AND DA(T) = 29  AND LP(T) = 0  THEN  PRINT G$;: GOTO 100
  17. 127 DY(T) = DA(T): IF MO(T) >1  THEN  RESTORE : FOR I = 1 TO MO(T) -1: READ A$,LE:DY(T) = DY(T) +LE: NEXT 
  18. 128  IF LP(T) = 1  AND MO(T) >2  THEN DY(T) = DY(T) +1
  19. 130  SPEED= 255:Y1 = 1801:D1 = 1:L1 = 0:Y2 = YR(T):D2 = DY(T): GOSUB 5000:DD(T) = DD: RESTORE : FOR I = 1 TO 24: READ A$: NEXT : FOR I = 1 TO 1 +DD - INT(DD/7) *7: READ DA$: NEXT : VTAB V +4: PRINT "  ";DA$: DATA THURSDAY,FRIDAY,SATURDAY,SUNDAY,MONDAY,TUESDAY,WEDNESDAY
  20. 132  PRINT "  DAY OF YEAR: ";DY(T): IF LP(T)  THEN  PRINT "  (LEAP YEAR)"
  21. 133  GOSUB 6000
  22. 135  RETURN 
  23. 140  NORMAL : HTAB 1: FOR I = 1 TO 40: PRINT "-";: NEXT : RETURN :<CTRL-M><CTRL-M><CTRL-M>
  24. 5000  NORMAL : IF Y1 = Y2  THEN DD = D2 -D1: RETURN 
  25. 5055 DD = D2 +365 +L1 -D1: IF Y2 = Y1 +1  THEN  RETURN 
  26. 5060 DD = DD +365 *(Y2 -Y1 -1): FOR I = Y1 +1 TO Y2 -1: IF (I - INT(I/4) *4 >0)  OR I = 1900  THEN  NEXT 
  27. 5062 YR = I: FOR I = YR TO Y2 -1  STEP 4: IF I < >1900  THEN DD = DD +1
  28. 5063  NEXT : RETURN :<CTRL-M><CTRL-M><CTRL-M><CTRL-M>
  29. 6000  VTAB V +1: HTAB 1: PRINT "DATE #";T;":";: CALL  -868: HTAB 21: PRINT MO$;" ";YR(T):DW = DD -DA(T) +1:D1 = DW - INT(DW/7) *7:D1 = D1 +5:D1 = D1 -7 *(D1 >7):HT = D1 *3 +18: VTAB 2 +V:DA = 1
  30. 6010  HTAB HT: POKE 50,63 +192 *(DA < >DA(T)): PRINT  SPC( DA <10);DA;:DA = DA +1:HT = HT +3 -21 *(HT = 39): IF DA < VAL(LE$) +1  THEN 6010
  31. 6030  RETURN 
  32. 63900  NORMAL : HOME : VTAB 10: HTAB 5: PRINT "BEAGLE BAG": HTAB 5: PRINT "------------------"
  33. 63910  VTAB 12: PRINT "<M> MENU": PRINT "<C> CONTINUE THIS GAME": PRINT "<Q> QUIT": HTAB 5: PRINT "------------------": PRINT "    SELECT:";: GET A$: PRINT A$: IF A$ = "Q"  THEN  END 
  34. 63920  IF A$ = "M"  THEN  POKE 768,16: PRINT  CHR$(4);"RUN SHORT MENU"
  35. 63930  IF A$ = "C"  THEN  RUN 
  36. 63940  GOTO 63900